home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / docs / winer / qsort.bas < prev    next >
Encoding:
BASIC Source File  |  1992-05-13  |  2.1 KB  |  85 lines
  1. '********* QSORT.BAS - Quick Sort algorithm demonstration
  2.  
  3. 'Copyright (c) 1992 Ethan Winer
  4.  
  5. DEFINT A-Z
  6. DECLARE SUB QSort (Array!(), StartEl, NumEls)
  7.  
  8. RANDOMIZE TIMER         'generate a new series each run
  9.  
  10. DIM Array!(1 TO 21)             'create an array
  11. FOR X = 1 TO 21                 'fill with random numbers
  12.     Array!(X) = RND(1) * 500    'between 0 and 500
  13. NEXT
  14.  
  15. FirstEl = 6                     'sort starting here
  16. NumEls = 10                     'sort this many elements
  17.  
  18. CLS
  19. PRINT "Before Sorting:"; TAB(31); "After sorting:"
  20. PRINT "==============="; TAB(31); "=============="
  21.  
  22. FOR X = 1 TO 21                 'show them before sorting
  23.     IF X >= FirstEl AND X <= FirstEl + NumEls - 1 THEN
  24.       PRINT "==>";
  25.     END IF
  26.     PRINT TAB(5); USING "###.##"; Array!(X)
  27. NEXT
  28.  
  29. CALL QSort(Array!(), FirstEl, NumEls)
  30.  
  31. LOCATE 3
  32. FOR X = 1 TO 21                 'print them after sorting
  33.     LOCATE , 30
  34.     IF X >= FirstEl AND X <= FirstEl + NumEls - 1 THEN
  35.       PRINT "==>";              'point to sorted items
  36.     END IF
  37.     LOCATE , 35
  38.     PRINT USING "###.##"; Array!(X)
  39. NEXT
  40.  
  41. SUB QSort (Array!(), StartEl, NumEls) STATIC
  42.  
  43. REDIM QStack(NumEls \ 5 + 10) 'create a stack
  44.  
  45. First = StartEl               'initialize work variables
  46. Last = StartEl + NumEls - 1
  47.  
  48. DO
  49.   DO
  50.     Temp! = Array!((Last + First) \ 2)  'seek midpoint
  51.     I = First
  52.     J = Last
  53.  
  54.     DO     'reverse both < and > below to sort descending
  55.       WHILE Array!(I) < Temp!
  56.         I = I + 1
  57.       WEND
  58.       WHILE Array!(J) > Temp!
  59.         J = J - 1
  60.       WEND
  61.       IF I > J THEN EXIT DO
  62.       IF I < J THEN SWAP Array!(I), Array!(J)
  63.       I = I + 1
  64.       J = J - 1
  65.     LOOP WHILE I <= J
  66.  
  67.     IF I < Last THEN                    'Done
  68.       QStack(StackPtr) = I              'Push I
  69.       QStack(StackPtr + 1) = Last       'Push Last
  70.       StackPtr = StackPtr + 2
  71.     END IF
  72.  
  73.     Last = J
  74.   LOOP WHILE First < Last
  75.  
  76.   IF StackPtr = 0 THEN EXIT DO
  77.   StackPtr = StackPtr - 2
  78.   First = QStack(StackPtr)              'Pop First
  79.   Last = QStack(StackPtr + 1)           'Pop Last
  80. LOOP
  81.  
  82. ERASE QStack               'delete the stack array
  83.  
  84. END SUB
  85.